HPAVC/HPAVC CD-ROM.iso/pc/FGFX11.ZIP/EFFECTS.PAS

Pascal/Delphi Source File | 1994-04-11 | 21.2 KB | 690 lines

{*****************************************************************************
*                                                                            *
*  EFFECTS.PAS                                                               *
*                                                                            *
*  This program demonstrates several methods of fading in an image from an   *
*  off-screen video page using either Fastgraph or Fastgraph/Light.  The set *
*  of routines provided herein are written for 320 x 200 graphics video      *
*  modes, but they could easily be extended to work in other resolutions.    *
*                                                                            *
*  The examples are by no means all inclusive.  Rather, their purpose is to  *
*  illustrate a few methods of creating special effects with Fastgraph or    *
*  Fastgraph/Light.                                                          *
*                                                                            *
*  To compile this program and link it with Fastgraph or Fastgraph/Light:    *
*                                                                            *
*     TPC EFFECTS                                                            *
*                                                                            *
*  Fastgraph (tm) and Fastgraph/Light (tm) are graphics libraries published  *
*  by Ted Gruber Software.  For more info, please call, write, or FAX.       *
*                                                                            *
*  Ted Gruber Software                           orders/info [phone]  *
*  PO Box 13408                                          FAX [phone]  *
*  Las Vegas, NV  89112                                  BBS [phone]  *
*                                                                            *
*****************************************************************************}

program main;
uses fgmain, fgmisc, fgpr;

var

   delay, scroll_delay : integer;
   old_mode, new_mode : integer;
   status : integer;
   count : word;
   start_time : longint;

{*****************************************************************************
*                                                                            *
*  announce                                                                  *
*                                                                            *
*  Display the name of the special effect we're about to see.                *
*                                                                            *
*****************************************************************************}

procedure announce (message : string);

var

   len : integer;
   i, y : integer;

begin

   { clear the screen }

   fg_erase;

   { display the specified message at the top row }

   fg_setcolor(15);
   len := length(message);
   fg_locate(0,20-(len div 2));
   fg_text(message,len);

   { scroll the message to the center of the screen }

   fg_setcolor(0);
   y := 0;

   for i := 0 to 24 do
   begin
      fg_scroll(0,319,y,y+7,4,1);
      fg_stall(scroll_delay);
      y := y + 4;
   end;

   { wait 1.5 seconds }

   fg_waitfor(27);

end;

{*****************************************************************************
*                                                                            *
*  irandom                                                                   *
*                                                                            *
*  Random number generator used in some of the effects.  It returns an       *
*  integer between min and max inclusive.                                    *
*                                                                            *
*****************************************************************************}

function irandom (min, max : integer) : integer;

begin

   irandom := random(max-min+1) + min;

end;

{*****************************************************************************
*                                                                            *
*  curtain                                                                   *
*                                                                            *
*  Reveal each row, one at a time, starting from the bottom and proceeding   *
*  to the top.  This gives the effect of a curtain rising, hence the name.   *
*                                                                            *
*****************************************************************************}

procedure curtain (delay : integer);

var

   y : integer;

begin

   for y := 199 downto 0 do
   begin
      fg_restore(0,319,y,y);
      fg_stall(delay);
   end;

end;

{*****************************************************************************
*                                                                            *
*  diagonal_fade                                                             *
*                                                                            *
*  This reveals the hidden page in two diagonal segments, separated by an    *
*  imaginary line extending from the lower left corner to the upper right    *
*  corner of the screen.  We start with the top line of the left segment and *
*  the bottom line of the right segment, and continue until the entire       *
*  screen is revealed.                                                       *
*                                                                            *
*****************************************************************************}

procedure diagonal_fade (delay : integer);

var

   xmin, xmax : integer;
   ymin, ymax : integer;

begin

   xmin := 0;
   xmax := 319;
   ymin := 0;
   ymax := 199;

   while (xmax > 0) do
   begin
      fg_restore(0,xmax,ymin,ymin+4);
      fg_restore(xmin,319,ymax-4,ymax);
      fg_stall(delay);

      xmin := xmin + 8;
      xmax := xmax - 8;
      ymin := ymin + 5;
      ymax := ymax - 5;
   end;

end;

{*****************************************************************************
*                                                                            *
*  horizontal_random_fade                                                    *
*                                                                            *
*  In this effect, the screen is divided into a series of two-pixel high     *
*  rows.  Each row is revealed in random parts from left to right.  This     *
*  process repeats 20 times, once for each row.  At the end, a call to the   *
*  fg_restore routine guarantees that all rows are transferred.              *
*                                                                            *
*****************************************************************************}

procedure horizontal_random_fade (delay : integer);

var

   i, j : integer;
   xwidth : integer;
   xmin, xmax : integer;
   y : integer;
   xpos : array [0..99] of integer;

begin

   for j := 0 to 99 do
      xpos[j] := 0;

   for i := 1 to 20 do
   begin
      for j := 0 to 99 do
      begin
         xmin := xpos[j];
         if (xmin < 320) then
         begin
            xmax := xmin + irandom(1,10) * 8;
            if (xmax > 320) then xmax := 320;
            y := j * 2;
            fg_restore(xmin,xmax-1,y,y+1);
            xpos[j] := xmax;
         end;
      end;
      fg_stall(delay);
   end;

   { make sure we got them all }

   fg_restore(0,319,0,199);

end;

{*****************************************************************************
*                                                                            *
*  inward_tunnel_effect                                                      *
*                                                                            *
*  Starting at the screen edges, reveal the screen through a series of       *
*  concentric hollow rectangles.                                             *
*                                                                            *
*****************************************************************************}

procedure inward_tunnel_effect (delay : integer);

var
   xmin, xmax : integer;
   ymin, ymax : integer;

begin

   xmin := 0;
   xmax := 319;
   ymin := 0;
   ymax := 199;

   while (xmin < xmax) do
   begin
      fg_restore(0,319,ymin,ymin+4);
      fg_restore(xmax-7,xmax,0,199);
      fg_restore(0,319,ymax-4,ymax);
      fg_restore(xmin,xmin+7,0,199);
      fg_stall(delay);

      xmin := xmin + 8;
      xmax := xmax - 8;
      ymin := ymin + 5;
      ymax := ymax - 5;
   end;

end;

{*****************************************************************************
*                                                                            *
*  outward_tunnel_effect                                                     *
*                                                                            *
*  Starting at the screen center, reveal the screen through a series of      *
*  concentric hollow rectangles.                                             *
*                                                                            *
*****************************************************************************}

procedure outward_tunnel_effect (delay : integer);

var

   xmin, xmax : integer;
   ymin, ymax : integer;

begin

   xmin := 152;
   xmax := 167;
   ymin := 95;
   ymax := 104;

   while (xmin >= 0) do
   begin
      fg_restore(xmin,xmax,ymin,ymin+5);
      fg_restore(xmax-7,xmax,ymin,ymax);
      fg_restore(xmin,xmax,ymax-4,ymax);
      fg_restore(xmin,xmin+7,ymin,ymax);
      fg_stall(delay);

      xmin := xmin - 8;
      xmax := xmax + 8;
      ymin := ymin - 5;
      ymax := ymax + 5;
   end;

end;

{*****************************************************************************
*                                                                            *
*  spiral_dual                                                               *
*                                                                            *
*  In this effect, we reveal the screen through two spirals.  One spiral     *
*  emanates clockwise from the screen edges to the screen center, while the  *
*  other emanates counterclockwise from the center to the screen edges.      *
*                                                                            *
*****************************************************************************}

procedure spiral_dual (delay : integer);

var

   xmin_outer, xmax_outer : integer;
   ymin_outer, ymax_outer : integer;
   xmin_inner, xmax_inner : integer;
   ymin_inner, ymax_inner : integer;

begin

   xmin_outer := 0;
   xmax_outer := 319;
   ymin_outer := 0;
   ymax_outer := 199;

   xmin_inner := 152;
   xmax_inner := 167;
   ymin_inner := 95;
   ymax_inner := 104;

   while (xmin_outer < xmin_inner) do
   begin
      fg_restore(xmin_outer,xmax_outer,ymin_outer,ymin_outer+4);
      fg_stall(delay);
      fg_restore(xmin_inner,xmax_inner,ymax_inner-4,ymax_inner);
      fg_stall(delay);
      fg_restore(xmax_outer-7,xmax_outer,ymin_outer,ymax_outer);
      fg_stall(delay);
      fg_restore(xmax_inner+1,xmax_inner+8,ymin_inner,ymax_inner);
      fg_stall(delay);
      fg_restore(xmin_outer,xmax_outer,ymax_outer-4,ymax_outer);
      fg_stall(delay);
      fg_restore(xmin_inner-8,xmax_inner,ymin_inner,ymin_inner+4);
      fg_stall(delay);
      fg_restore(xmin_outer,xmin_outer+7,ymin_outer,ymax_outer);
      fg_stall(delay);
      fg_restore(xmin_inner-8,xmin_inner-1,ymin_inner,ymax_inner+5);
      fg_stall(delay);

      xmin_outer := xmin_outer + 8;
      xmax_outer := xmax_outer - 8;
      ymin_outer := ymin_outer + 5;
      ymax_outer := ymax_outer - 5;

      xmin_inner := xmin_inner - 8;
      xmax_inner := xmax_inner + 8;
      ymin_inner := ymin_inner - 5;
      ymax_inner := ymax_inner + 5;
   end;

end;

{*****************************************************************************
*                                                                            *
*  spiral_layered                                                            *
*                                                                            *
*  This effect is similar to the normal spiral.  Instead of revealing the    *
*  screen in one iteration, this effect does so in four iterations (layers), *
*  each moving more toward the screen center.                                *
*                                                                            *
*****************************************************************************}

procedure spiral_layered (delay : integer);

var

   i : integer;
   xmin, xmax : integer;
   ymin, ymax : integer;

begin

   for i := 0 to 3 do
   begin
      xmin := i * 8;
      xmax := 319 - xmin;
      ymin := i * 5;
      ymax := 199 - ymin;

      while (xmin < xmax) do
      begin
         fg_restore(xmin,xmax,ymin,ymin+4);
         fg_stall(delay);
         fg_restore(xmax-7,xmax,ymin,ymax);
         fg_stall(delay);
         fg_restore(xmin,xmax,ymax-4,ymax);
         fg_stall(delay);
         fg_restore(xmin,xmin+7,ymin,ymax);
         fg_stall(delay);

         xmin := xmin + 32;
         xmax := xmax - 32;
         ymin := ymin + 20;
         ymax := ymax - 20;
      end;
   end;

end;

{*****************************************************************************
*                                                                            *
*  spiral_normal                                                             *
*                                                                            *
*  This is a spiral effect in which we reveal the screen as a series of      *
*  rectangles, emanating from the screen edges and proceeding clockwise to   *
*  the center of the screen.                                                 *
*                                                                            *
*****************************************************************************}

procedure spiral_normal (delay : integer);

var

   xmin, xmax : integer;
   ymin, ymax : integer;

begin

   xmin := 0;
   xmax := 319;
   ymin := 0;
   ymax := 199;

   while (xmin < xmax) do
   begin
      fg_restore(xmin,xmax,ymin,ymin+19);
      fg_stall(delay);
      fg_restore(xmax-31,xmax,ymin,ymax);
      fg_stall(delay);
      fg_restore(xmin,xmax,ymax-19,ymax);
      fg_stall(delay);
      fg_restore(xmin,xmin+31,ymin,ymax);
      fg_stall(delay);

      xmin := xmin + 32;
      xmax := xmax - 32;
      ymin := ymin + 20;
      ymax := ymax - 20;
   end;

end;

{*****************************************************************************
*                                                                            *
*  split_screen                                                              *
*                                                                            *
*  Reveal the top half of from left to right while revealing the bottom half *
*  from right to left.                                                       *
*                                                                            *
*****************************************************************************}

procedure split_screen (delay : integer);

var

   xmin, xmax : integer;

begin

   xmin := 0;
   xmax := 319;

   while (xmax > 0) do
   begin
      fg_restore(xmin,xmin+7,0,99);
      fg_restore(xmax-7,xmax,100,199);
      fg_stall(delay);
      xmin := xmin + 8;
      xmax := xmax - 8;
   end;

end;

{*****************************************************************************
*                                                                            *
*  unveil                                                                    *
*                                                                            *
*  Starting at the center, reveal the screen in small horizontal increments  *
*  until we reach the left and right edges.                                  *
*                                                                            *
*****************************************************************************}

procedure unveil (delay : integer);

var

   xmin, xmax : integer;

begin

   xmin := 152;
   xmax := 167;

   while (xmin >= 0) do
   begin
      fg_restore(xmin,xmin+7,0,199);
      fg_restore(xmax-7,xmax,0,199);
      fg_stall(delay);
      xmin := xmin - 8;
      xmax := xmax + 8;
   end;

end;

{*****************************************************************************
*                                                                            *
*  venetian_blind                                                            *
*                                                                            *
*  Reveal the screen in four iterations, each revealing every fourth row.    *
*  The effect produced resembles opening a Venetian blind.                   *
*                                                                            *
*****************************************************************************}

procedure venetian_blind (delay : integer);

var

   y : integer;

begin

   y := 0;
   while (y < 200) do
   begin
      fg_restore(0,319,y,y);
      y := y + 4;
   end;
   fg_stall(delay);

   y := 1;
   while (y < 200) do
   begin
      fg_restore(0,319,y,y);
      y := y + 4;
   end;
   fg_stall(delay);

   y := 2;
   while (y < 200) do
   begin
      fg_restore(0,319,y,y);
      y := y + 4;
   end;
   fg_stall(delay);

   y := 3;
   while (y < 200) do
   begin
      fg_restore(0,319,y,y);
      y := y + 4;
   end;
   fg_stall(delay);

end;

{*****************************************************************************
*                                                                            *
*  main program                                                              *
*                                                                            *
*****************************************************************************}

begin

   { make sure a 320 x 200 color graphics mode is available }

   new_mode := fg_bestmode(320,200,2);
   if (new_mode < 0) or (new_mode = 12) then
   begin
      writeln('This program requires a 320 x 200 color graphics mode.');
      exit;
   end;

   { determine the number of delay units per half clock tick }

   delay := fg_measure div 2;

   { initialize Fastgraph for the selected video mode }

   old_mode := fg_getmode;
   fg_setmode(new_mode);
   status := fg_allocate(1);

   { display a packed pixel run file on a hidden page }

   fg_sethpage(1);
   fg_setpage(1);
   fg_move(0,199);
   fg_dispfile('FG.PPR'+chr(0),320,1);
   fg_setpage(0);

   { compute the number of delay units needed to make the text scroll }
   { down at the same rate, regardless of the CPU speed or video mode }

   count := 0;
   fg_waitfor(1);
   start_time := fg_getclock;
   repeat
   begin
      fg_scroll(0,319,0,7,4,1);
      inc(count);
   end;
   until (fg_getclock <> start_time);

   scroll_delay := (delay div 8) - (delay * 2) div count;
   if (scroll_delay < 0) then scroll_delay := 0;

   { demonstrate the inward tunnel effect }

   announce('inward tunnel effect');
   inward_tunnel_effect(0);
   fg_waitfor(27);
   announce('inward tunnel effect with delay');
   inward_tunnel_effect(delay);
   fg_waitfor(27);

   { demonstrate the outward tunnel effect }

   announce('outward tunnel effect');
   outward_tunnel_effect(0);
   fg_waitfor(27);
   announce('outward tunnel effect with delay');
   outward_tunnel_effect(delay);
   fg_waitfor(27);

   { demonstrate the diagonal fade }

   announce('diagonal fade');
   diagonal_fade(0);
   fg_waitfor(27);
   announce('diagonal fade with delay');
   diagonal_fade(delay div 2);
   fg_waitfor(27);

   { demonstrate the horizontal random fade }

   announce('horizontal random fade');
   horizontal_random_fade(delay);
   fg_waitfor(27);

   { demonstrate the curtain effect }

   announce('curtain');
   curtain(delay div 8);
   fg_waitfor(27);

   { demonstrate the spiral effect }

   announce('spiral');
   spiral_normal(delay*2);
   fg_waitfor(27);

   { demonstrate the layered spiral effect }

   announce('layered spiral');
   spiral_layered(delay);
   fg_waitfor(27);

   { demonstrate the dual spiral effect }

   announce('dual spiral');
   spiral_dual(delay div 2);
   fg_waitfor(27);

   { demonstrate the split screen effect }

   announce('split screen');
   split_screen(delay div 2);
   fg_waitfor(27);

   { demonstrate the unveil effect }

   announce('unveil');
   unveil(delay div 4);
   fg_waitfor(27);

   { demonstrate the 'venetian blind' effect }

   announce('venetian blind');
   venetian_blind(delay);
   fg_waitfor(27);

   { restore the original video mode and screen attributes }

   status := fg_freepage(1);
   fg_setmode(old_mode);
   fg_reset;
end.